home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / windows.arc / GROWWIN.INC < prev    next >
Encoding:
Text File  |  1985-02-23  |  3.3 KB  |  96 lines
  1. Procedure Write_Screen(long_string:maxstr; xcoord,ycoord,color: integer);
  2.  
  3. var str_len, real_pos, scr_pos: integer;
  4.  
  5. begin
  6.      str_len:=length(long_string);
  7.      Scr_pos:=0;
  8.      for real_pos:=1 to str_len do
  9.                  if scr_pos < 4001 then
  10.                        begin
  11.                             scr_pos:=((xcoord*2)-1)+(ycoord*160);
  12.                             Page_1[scr_pos]:=ord(copy(long_string,real_pos,1));
  13.                             Page_1[scr_pos+1]:=Color;
  14.                             xcoord:=xcoord+1;
  15.                        end
  16. end;
  17.  
  18. Procedure Grow_Frame(WindowType, UpperLeftX, UpperLeftY, LowerRightX, LowerRightY, color: Integer);
  19. var i: integer;
  20. begin
  21.      Write_Screen(chr(Fc[WindowType,1]),UpperLeftX, UpperLeftY,Color);
  22.      for i:=UpperLeftX+1 to LowerRightX-1 do Write_Screen(chr(Fc[WindowType,2]),i,UpperleftY,color);
  23.      Write_Screen(chr(Fc[WindowType,3]),i+1,UpperleftY,color);
  24.      for i:=UpperLeftY+1 to LowerRightY-1 do
  25.          begin
  26.               Write_Screen(chr(Fc[WindowType,4]),UpperLeftX , i,color);
  27.               Write_Screen(chr(Fc[WindowType,4]),LowerRightX, i,color);
  28.          end;
  29.      Write_Screen(chr(Fc[WindowType,5]),UpperLeftX, LowerRightY, color);
  30.      for i:=UpperLeftX+1 to LowerRightX-1 do Write_Screen(chr(Fc[WindowType,6]),i,LowerrightY,color);
  31.      Write_Screen(chr(Fc[WindowType,7]),i+1,LowerRightY,color)
  32. end ;
  33.  
  34. Procedure Grow_Window(x1,y1,x2,y2,c1,c2,wt:integer);
  35.  
  36. var i,j,p1,p2,p3,p4,sl,knt:integer;
  37.  
  38. begin
  39.      p1:=x1+trunc((x2-x1)/2);
  40.      p2:=y1+trunc((y2-(y1))/2);
  41.      p3:=p1;
  42.      p4:=p2;
  43.      Scrn_off;
  44.      Move(real_Screen,page_1,4000);
  45.      Scrn_on;
  46.      Set_page($01);
  47.      if p1>p2 then knt:=trunc((x2-x1)/2)
  48.               else knt:=trunc((y2-y1)/2);
  49.      y1:=y1-1;
  50.      y2:=y2-1;
  51.      x1:=x1+1;
  52.      x2:=x2-1;
  53.      for sl:=1 to round(Knt/3) do
  54.           begin
  55.                   if p1>(x1-2) then
  56.                           p1:=p1-3
  57.                   else
  58.                   if p1>(x1-1) then
  59.                           p1:=p1-2
  60.                   else
  61.                      if p1>x1 then
  62.                           p1:=p1-1;
  63.                   if p3<(x2+2) then
  64.                           p3:=p3+3
  65.                   else
  66.                   if p3<(x2+1) then
  67.                           p3:=p3+2
  68.                   else
  69.                      if p3<x2 then
  70.                           p3:=p3+1;
  71.                   if p2>(y1+2) then
  72.                           p2:=p2-3
  73.                   else
  74.                   if p2>(y1+1) then
  75.                           p2:=p2-2
  76.                   else
  77.                      if p2>y1 then
  78.                           p2:=p2-1;
  79.                   if p4<(y2-2) then
  80.                           p4:=p4+3
  81.                   else
  82.                   if p4<(y2-1) then
  83.                           p4:=p4+2
  84.                   else
  85.                      if p4<y2 then
  86.                           p4:=p4+1;
  87.                Normvideo;
  88.                window(p1,p2,p3,p4);
  89.                clrscr;
  90.                Grow_frame(wt,p1,p2,p3,p4,(c1+(c2*16)));
  91.           end;
  92.     p2:=p2+1;
  93.     p4:=p4+1;
  94.     Add_Window(p1,p2,p3,p4,c1,c2,wt);
  95.     Set_page($00)
  96. end;